home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
swindows.zip
/
LABELS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-04-09
|
4KB
|
149 lines
program labels;
{
A Program to print mailing labels
Written to demonstrate use of the INPUT.TPU unit.
by David C. Swaim II, Ph.D. (3/88)
P. O. Box 1658
Lawrenceville, GA. 30246
}
uses
Crt,Printer,Input,hwindows;
const
CtrlEnd = #117;
var
CursorX,CursorY: Byte;
NoLabels,i,LineNo,ColNo: Integer;
LabelLines: array[1..5] of InputString;
ScrnPtr: Pointer;
Procedure PrintLabels;
var
i,j: Integer;
InKey: Char;
begin
Inkey := NULL;
for j := 1 to NoLabels do
begin
for i := 1 to 5 do Writeln(Lst,LabelLines[i]);
Writeln(Lst,' ');
if KeyPressed then Inkey := ReadKey;
if Inkey = Esc then Exit;
end;
end;
begin
CursorX := WhereX;
CursorY := WhereY - 1;
SaveScreen(ScrnPtr);
ClrScr;
NOLabels := 1;
for i := 1 to 5 do
begin
LabelLines[i] := '';
end;
TextColor(Yellow);
GotoXY(25,1);
Writeln('Label Printer Program');
GotoXY(25,3);
TextColor(LightGray);
Writeln('From Simple Software Solutions');
GotoXY(25,4);
Writeln(' P. O. Box 1658');
GotoXY(25,5);
Writeln(' Lawrenceville, Georgia 30246');
Writeln;
TextColor(LightCyan);
Writeln('A program to print standard 3.5" X 15/16" labels (five lines).');
Writeln;
TextColor(Yellow);
Write('Number of Labels to Print: ');
TextColor(LightGray);
Writeln(NoLabels:3);
GotoXY(1,11);
TextColor(White);
Writeln(' +---------+---------+---------+---------+');
TextColor(Yellow);
Writeln('Line 1:');
Writeln('Line 2:');
Writeln('Line 3:');
Writeln('Line 4:');
Writeln('Line 5:');
TextColor(White);
Writeln(' +---------+---------+---------+---------+');
GotoXY(1,21);
TextColor(LightRed);
Writeln('F1 = Print Label Ctrl End = End Program');
NoLabels := 1;
LineNo := 0;
FileIn := False;
TextColor(LightGray);
{
CtrlEnd or Esc will end the program.
}
While (Control <> Esc) and (Control <> CtrlEnd) do { Ctrl End stops program }
begin
if LineNo = 0 then
begin
Str(NoLabels:3,Indata);
Maxin := 3;
Insrt := False;
Numin := True;
x := 28;
y := 9;
end
else
begin
Indata := LabelLines[LineNo];
Maxin := 40;
Insrt := True;
Numin := False;
x := 9;
y := LineNo + 11;
end;
GetIn(Numin,FileIn,Maxin,x,y,Indata,Insrt,Control,Number);
if LineNo = 0 then
NoLabels := Trunc(Number)
else
LabelLines[LineNo] := Indata;
if Control <> NULL then
Case Control of
CsrUp: begin
LineNo := LineNo - 1;
if LineNo < 0 then LineNo := 5;
end;
CsrDn: begin
LineNo := LineNo + 1;
if LineNo > 5 then LineNo := 0;
end;
F1: begin
GotoXY(1,22);
Writeln('Printing, Stand by. Press Esc to stop printing.');
PrintLabels;
GotoXY(1,22);
Writeln(' ');
end;
else begin
LineNo := LineNo + 1;
if LineNo > 5 then LineNo := 0;
end;
end {Case}
else
begin
LineNo := LineNo + 1;
if LineNo > 5 then LineNo := 0;
end;
end; {while}
CursorOn;
RestoreScreen(ScrnPtr);
GotoXY(CursorX,CursorY);
end.